Rapid Fire Choice Analyses

Rapid Fire

In the document I said that I would drop all subjects with a mean choice RT longer than 1 s, but in retrospect I don’t know about that because I would expect RTs to be under this. I had the instinct to plot the predicted effects broken down by phase but then realized that that information should not be used to decide whether the rapid fire data should be included in the overall analysis. So, even though plotting the effects by phase seems like an obvious thing to do here, I’m going to explicitly refrain from doing it.

Let’s compare the rt distributions for each subject:

Randomly selecting 15 subjects to look at using this cool new plot I found:

ranSubjects <- sample(unique(dst$subject), 15)

d <- dst %>% 
  select(subject, choiceRt) %>% 
  rename(dstChoiceRt = choiceRt) %>% 
  inner_join(rapidFire) %>% 
  rename(rfChoiceRt = choiceRt) %>% 
  select(subject, rfChoiceRt, dstChoiceRt) %>% 
  gather(phase, rt, rfChoiceRt, dstChoiceRt) %>% 
  filter(rt < 5000)

## Joining, by = "subject"

d %>% 
  filter(subject %in% ranSubjects) %>% 
  mutate(subject = as.factor(subject)) %>% 
  ggplot(aes(x = rt, y = subject)) + 
  ## scale controls how much the densities overlap -- higher numbers = more overlap
  geom_density_ridges(aes(fill = phase), alpha = 0.8, color = 'white', scale = 1.3) +
  scale_fill_cyclical(name = 'Phase',  
                      labels = c(`dstChoiceRt` = 'Demand Selection Task', `rfChoiceRt` = 'Rapid Fire'), 
                      values = c('#ff0000', '#0000ff', '#ff8080', '#8080ff'), guide = 'legend') + 
  theme_ridges(grid = FALSE) +
  labs(
    x = 'Response Time (ms)',
    y = 'Subject',
    title = 'Response times across the two choice phases of the experiment',
    subtitle = 'Are people just spamming their way through the rapid fire choices?'
  ) +
  theme(legend.position = 'bottom',
        axis.text.y = element_blank())

## Picking joint bandwidth of 60.7

Now doing it in a way that better captures all subject data:

d %>% 
  group_by(subject, phase) %>% 
  summarize(rtTime = mean(rt), se = sd(rt) / sqrt(N)) %>% 
  rename(rt = rtTime) %>% 
  ggplot(aes(x = subject, y = rt, group = phase)) +
  geom_point(aes(color = phase)) +
  geom_errorbar(aes(ymin = rt - se, ymax = rt + se), width = 0.5) +
  scale_color_manual(name = 'Phase', values = c(dstChoiceRt = 'red', rfChoiceRt = 'blue'), labels = c(dstChoiceRt = 'Demand Selection Phase', rfChoiceRt = 'Rapid Fire Phase')) +
  labs(
    x = 'Subject',
    y = 'Response Time (ms)'
  ) + 
  theme_bw() +
  coord_flip() +
  theme(axis.text.y = element_blank(),
        axis.ticks.y = element_blank(),
        legend.position = 'bottom')

d %>% 
  group_by(subject, phase) %>% 
  summarize(rt = mean(rt)) %>% 
  ggplot(aes(x = rt, y = phase)) +
  #geom_density(aes(fill = phase), color = 'black', alpha = 0.2)
  geom_density_ridges(aes(fill = phase), alpha = 0.7, scale = 2, color = 'white') +
  scale_fill_manual(name = 'Phase', values = c(dstChoiceRt = 'red', rfChoiceRt = 'blue'), labels = c(dstChoiceRt = 'Demand Selection Phase', rfChoiceRt = 'Rapid Fire Phase')) +
  labs(x = 'Response Time (ms)', caption = 'Histograms represent distribution of subject means') +
  theme_bw() +
  theme(axis.title.y = element_blank(),
        axis.text.y = element_blank(),
        axis.ticks.y = element_blank(),
        legend.position = 'bottom')

## Picking joint bandwidth of 209

Maybe the most important thing to get a handle on is whether the

I can also try to get a sense of whether people are spamming through the rapid fire by looking at proportion selection of left / right deck throughout the phase.

rapidFire %>% 
  mutate(rfChoice = ifelse(selectedDeckLocation == 'right', 1, 0)) %>% 
  select(subject, rfChoice) %>% 
  inner_join(dst) %>% 
  mutate(dstChoice = ifelse(selectedDeckLocation == 'right', 1, 0),
         subject = as.factor(subject)) %>% 
  gather(phase, isRight, rfChoice, dstChoice) %>% 
  mutate(phase = as.factor(phase)) %>% 
  mutate(phase = recode(phase, 'dstChoice' = 'Demand Selection Phase', 'rfChoice' = 'Rapid Fire Phase')) %>% 
  group_by(subject, phase) %>% 
  summarize(right = mean(isRight), sd = sd(isRight)) %>% 
  ggplot(aes(x = subject, y = right)) + 
  geom_point(size = 3, shape = 18) +
  #geom_errorbar(aes(ymin = right - sd, ymax = right + sd), width = 0.2) + 
  geom_hline(yintercept = 0.5, linetype = 'dashed') + 
  facet_wrap(~phase) +
  theme_bw() + 
  coord_flip() +
  ylim(0, 1) +
  labs(
    x = 'Subject',
    y = 'Proportion Selection of Right Deck',
    title = 'Choice location bias across choice phases'
  ) +
  theme(axis.text.y = element_blank(),
        axis.ticks.y = element_blank(),
        panel.grid = element_blank(),
        strip.background = element_rect(fill = 'white', color = 'black'))

## Joining, by = "subject"

rapidFire %>% 
  mutate(isRight = ifelse(selectedDeckLocation == 'right', 1, 0)) %>% 
  group_by(subject) %>% 
  summarize(right = mean(isRight), se = sd(isRight) / sqrt(n()), n = n())

Let’s look at choice RT in rapid fire over time. Maybe people start out thinking about it for longer and then get frustrated toward the end.

a <- rapidFire %>% 
  select(subject, choiceRt, choiceTrial) %>% 
  mutate(phase = 'Rapid Fire Phase')

b <- dst %>% 
  select(subject, choiceRt, choiceTrial) %>% 
  mutate(phase = 'Demand Selection Phase')

plotData <- rbind(a, b)

plotData %>% 
  ggplot(aes(x = choiceTrial, y = choiceRt, group = subject)) +
  geom_line(alpha = 0.2) +
  xlim(0, 40)+
  facet_wrap(~phase) +
  labs(
    title = 'Choice response time over trial across the two choice phases',
    x = 'Trial',
    y = 'Response Time (ms)',
    caption = 'Each line represents a different subject'
  ) +
  theme_bw() +
  theme(strip.background = element_rect(fill = 'white', color = 'black'))